Shareware Grab Bag/Shareware Grab Bag.iso/090/updown.arc/UPDOWN.M

Text File | 1987-06-08 | 7.1 KB | 273 lines

;**
;**        BRIEF -- Basic Reconfigurable Interactive Editing Facility
;**
;**        Written by Dave Nanian and Michael Strickman.
;**

;**
;**        updown.m:
;**
;**        This macro file contains routines that upper and lowercase a block.
;**    these macros are a good example of how to write a block function.  They
;**    deal with all the known special cases, including tab fields and a
;**    "percent complete" display that compensates for the size of an integer.
;**
;**        The key assignments are as follows:
;**
;**        toupper:            Uppercases a block.  Assigned to Ctrl-F6.
;**
;**        tolower:            Lowercases a block.  Assigned to Ctrl-F5.
;**
;**        Revision history:
;**        -----------------
;**        1 December 1986        Rewrote to compensate for slight problem with
;**                                    BRIEF v1.33 and earlier versions.  Also
;**                                    optimized for speed.  Thanks to Michael Hannah
;**                                    who pointed out the speed problems in the first
;**                                    place.
;**
;**        25 May 1987                Modified assigned keys because BRIEF 2.0 uses
;**                                    Ctrl-F5 and Ctrl-F6 for other purposes.
;**                                    Started to use <Alt-9> as the equivalent of
;**                                    SmartKey's SuperShift.
;**                                    Used BRIEF 2.0's parameters for inq-marked.
;**                                    Added code for non-inclusive marks.
;**                                    Added an error message for column marks.
;**                                    Revised by Lew Paper

(macro updown
    (
        (assign_to_key "#-32768#108" "tolower")        ; <Alt-9> Lower case L.  LP
        (assign_to_key "#-32768#117" "toupper")        ; <Alt-9> u.  LP

; LP    (assign_to_key "%#98" "tolower")                    ;** Assigned to Ctrl-F5
; LP    (assign_to_key "%#99" "toupper")                    ;** Assigned to Ctrl-F6
    )
)


;**
;**        _block_case:
;**
;**        This generic function upper or lower cases a block, depending on
;**    the value of the first parameter.  Non-zero upper cases a block, zero
;**    lower cases it.
;**
;**        If no block is marked, the current line is "cased".
;**

(macro _block_case
    (
        (string    before
                    after
        )
        (int    start_line
                start_col
                end_line
                end_col
                block_type                        ; LP
                curr_line
                curr_col                            ; LP
                num_lines
                do_upper
                scale_factor
                num_chars
                before_line
                before_col
                after_line
                after_col
                line
                col
                done
        )
        (message "Case converting block...")
        (get_parm 0 do_upper)
        (save_position)

        (= block_type (inq_marked start_line start_col end_line end_col))    ; LP
                                                    ; Note that start always precedes end
                                                    ; and end_col for line mark is 20736,
                                                    ; while start_col is always correct

        (if (== block_type 2)                ; Column mark.  LP
            (                                        ; LP
                 (message "Can not convert column blocks yet")    ; LP
                (return 1)                        ; Dummy value  ; LP
            )                                        ; LP
        )                                            ; (if (== block_type 2) LP

        (if (! block_type)                    ; LP
; LP    (if (! (inq_marked))
            (
                (inq_position start_line)
                (= start_col 1)
                (end_of_line)
                (inq_position end_line end_col)
                (beginning_of_line)
            )
        ;else
            (
                (raise_anchor)                    ; Moved here to show that we are
                                                    ; done with the original block.  LP
                (if (== block_type 4)        ; Non-inclusive mark.  LP
                    (                                ; LP
                        (if (&& (== start_line end_line) (== start_col end_col))
                                                    ; Original block had only 1 character.
                                                    ; LP
                            (                        ; LP
                                (message "nothing to do")
                                (return 1)        ; Throw away value
                            )                        ; LP
                        )                            ; (if (&& (== start_line ... LP
                        (inq_position curr_line curr_col)    ; LP
                        (if (|| (!= curr_line start_line) (!= curr_col start_col))
                                                    ; Block marked in the upper left hand
                                                    ; corner, so skip the last character.  LP
                            (                        ; LP
                                (move_abs end_line end_col)    ; LP
                                (prev_char)        ; LP
                                (inq_position end_line end_col)
                            )                        ; LP
                        ;else                        ; Block marked in the lower right hand
                                                    ; corner, so skip the first character.  LP
                            (                        ; LP
                                (move_abs start_line start_col)    ; LP
                                (next_char)        ; LP
                                (inq_position start_line start_col)    ; LP
                            )                        ; LP
                        )                            ; (if (|| (!= curr_line...  LP
                    )
                )                                    ; (if (== block_type 4)  LP
                (move_abs start_line start_col)    ; LP
; LP            (inq_position start_line start_col)
; LP            (swap_anchor)
; LP            (inq_position end_line end_col)

; LP            (if (|| (< end_line start_line) (&& (== start_line end_line) (< end_col start_col)))
; LP                (
; LP                    (int    temp)
; LP                    (= temp end_line)
; LP                    (= end_line start_line)
; LP                    (= start_line temp)
; LP                    (= temp end_col)
; LP                    (= end_col start_col)
; LP                    (= start_col temp)
; LP                )
; LP            ;else
; LP                (swap_anchor)
; LP                (raise_anchor)
            )                                        ; ;else
        )                                             ; (if ! block_type)
        (= num_lines (+ (- end_line start_line) 1))
        (= curr_line start_line)

        (if (> num_lines 100)
            (= scale_factor (/ 32767 num_lines))
        ;else
            (= scale_factor 100)
        )
        (while (<= curr_line end_line)
            (
                (if (&& (!= curr_line end_line) (!= curr_line start_line))
                    (= before (read))
                ;else
                    (
                        (inq_position before_line before_col)
                        (prev_char)
                        (next_char)
                        (inq_position after_line after_col)

                        (if (|| (!= before_line after_line) (> after_col before_col))
                            (prev_char)
                        )
                        (save_position)
                        (end_of_line)
                        (inq_position NULL after_col)
                        (restore_position)

                        (if (|| (!= curr_line end_line) (<= after_col end_col))
                            (= before (read))
                        ;else
                            (
                                (save_position)

                                (while (! done)
                                    (
                                        (++ num_chars)
                                        (next_char)
                                        (inq_position line col)
                                        (= done (|| (!= line end_line) (> col end_col)))
                                    )
                                )
                                (restore_position)
                                (= before (read num_chars))
                            )
                        )
                    )
                )
                (if do_upper
                    (= after (upper before))
                ;else
                    (= after (lower before))
                )
                (if (!= after before)
                    (
                        (if (index after "\n")
                            (
                                (= after (substr after 1 (- (strlen after) 1)))
                                (delete_to_eol)
                            )
                        ;else
                            (
                                (drop_anchor)
                                (= num_chars (strlen after))

                                (while (> (-- num_chars) 0)
                                    (next_char)
                                )
                                (delete_block)
                            )
                        )
                        (insert after)
                    )
                )
                (move_abs (++ curr_line) 1)

                ;**
                ;**        This rather messy calculation scales things so that
                ;**    we get as much granularity as possible when computing
                ;**    percentages without overflowing an integer.
                ;**

                (message "Case converting block, %d%% complete..."
                            (/ (* 100 (/ (* (- curr_line start_line) scale_factor) num_lines)) scale_factor))
            )
        )
        (restore_position)
        (message "Case conversion completed.")
    )
)

;**
;**        toupper:
;**
;**        This simple macro calls _block_case with the parameter that means
;**    "Hey, guy, uppercase this block!"
;**

(macro toupper
    (_block_case 1)
)

;**
;**        tolower:
;**
;**        This simple macro calls _block_case with the parameter that means
;**    "Hey, guy, lowercase this block!"
;**

(macro tolower
    (_block_case 0)
)